Shareware Grab Bag/Shareware Grab Bag.iso/007/tutil.arc/LIB001.INC

Text File | 1984-07-09 | 6.7 KB | 269 lines

{.HE LIB001.INC             GetChar, GetString Procedures              Page #}
{.FO                              Last Update of LIB001.INC : 08-09-84    DJS}
{File : LIB001.INC      }
{ For : Turbo Pascal    }
{  By : David J. Smith  }
{Date : 07-09-84        }

Function GetChar : Char;

{This function will return a character from the keyboard.
 Escape Codes are returned in one character, being the the second
 character in the escape sequence with the high bit set chr(chr2 + 128).
 the keys <Alt> 9, <Alt> 0, <Alt> -, <Alt> +, and <Ctrl> <PgUp> Will
 return the codes 0 thru 4 since their key codes are greater than 128}

Const
  ESC = #027;

Var
  Ch1, Ch2 : Char;

begin {GetChar}
  Read(Kbd, ch1);
  if Ch1 = ESC then
    if keypressed then
      begin
        read(Kbd, Ch2);
        Ch1 := chr(ord(Ch2) + 128)
      End;  {If}
  GetChar := Ch1
end;  {GetChar}


{.PA}
Type InStringType = String[80];        {Required for GetString}

Procedure GetString(Var InString : InStringType; Picture : InStringType;
                    var Result : Char);

{Syntax :   GetString(InString, Picture, Result);

            Where InString and Picture are of type InStringType (String[80])
            and Result is of type Char.

GetString will get input from Kbd and validate it against the String 'Picture'
as Follows
     '9'  --  Allow Numeric data to be entered
     'A'  --  Allow only Alphabetic Data to be entered
     '!'  --  Allow any character, Alpha converted to upper case
     ' '  --  Allow any character
 all others will be preserved from the picture to the Instring Variable.
 Escape will exit the routine leaving InString Unchanged.}

Const
  SP = ' ';   {Space}             BS = #008;   {Back Space);
  CR = #013;  {Carraige Return}   ESC = #027;  {The Escape Character}
  LeftArrow = #203;               RightArrow = #205;
  Del = #211; {Del Key Code}      Ins = #210;  {Ins Key Code}
  BEL = #007; {Bell}

Type
  CharSet = Set of Char;

Var
  Ch : Char;
  Row, StartCol, StopCol, Pos : byte;
  WorkString : InStringType;
  Next, Done : Boolean;
  DigitChar, AlphaChar, PicChar, CntChar : CharSet;


{Subsidiary Procedures}

Procedure Initialize;

var Loop : Byte;

begin
  Row := WhereY;
  StartCol := WhereX;
  Done := Length(Picture) < Length(InString);
  If Done
    then
      begin
        GotoXY(1,24);
        Write(BEL,'ERROR : Instring Longer than Picture');
        Delay(2000);
        GotoXY(1,24);
        Write(SP:40);
        GotoXY(StartCol,Row)
      end {Then}
    else
      Begin
        DigitChar := ['0'..'9','.','+','-','e','E'];
        AlphaChar := ['a'..'z','A'..'Z'];
        PicChar := ['9','A','!',' '];
        CntChar := [chr(000)..chr(031),chr(128)..chr(255)];
        StopCol := StartCol + Length(Picture) - 1;
        WorkString := '';
        For Loop := 1 to Length(InString) do
          if Picture[loop] in PicChar
            then WorkString := WorkString + Instring[Loop]
            else WorkString := WorkString + Picture[Loop];
        For Loop := (Length(InString) + 1) to Length(Picture) do
          if Picture[Loop] in PicChar
            then WorkString := WorkString + SP
            else WorkString := WorkString + Picture[Loop];
        Pos := 1
      end {else}
end;  {Initialize}


Procedure WriteString(Var PrintString : InStringType);

var
  Loop, X, Y : Byte;

begin
  X := WhereX;
  Y := WhereY;
  For Loop := 1 to Length(Picture) do
    If Not(Picture[Loop] in PicChar)
      then PrintString[Loop] := Picture[Loop];
  GotoXY(StartCol,Row);
  Write(PrintString);
  GotoXY(X,Y)
End;  {WriteString}


Procedure MoveLeft;

begin
  Repeat
    if WhereX > StartCol
      then GotoXY(WhereX-1, WhereY);
    Pos := WhereX - StartCol + 1
  Until (Picture[Pos] in PicChar) or (WhereX = StartCol);
  Next := True
end;  {Move Left}


Procedure MoveRight;

begin
  repeat
    if WhereX < StopCol
      then GotoXY(WhereX+1,WhereY);
    Pos := WhereX - StartCol + 1
  Until (Picture[Pos] in PicChar) or (WhereX = StopCol);
  Next := True
end;  {Move Right}


Procedure DeleteChar;
{Delete Character at Current Position}

begin
  Delete(Workstring,Pos,1);
  WorkString := Workstring + SP;
  WriteString(WorkString);
  Next := True
end;  {DeleteChar}


Procedure InsertChar;
{Insert Space at Current Position}

Begin
  Delete(WorkString,Length(WorkString),1);
  Insert(SP,WorkString,Pos);
  WriteString(WorkString);
  Next := True
end;  {InsertChar}


Procedure AcceptCh;

begin
  WorkString[Pos] := Ch;
  MoveRight;
  Next := True;
  WriteString(WorkString)
end;  {AcceptCh}


Procedure ContCh;

begin
  case Ch of
            BS : begin
                   MoveLeft;
                   Ch := SP;
                   AcceptCh;
                   MoveLeft
                 end;

    RightArrow : MoveRight;

     LeftArrow : MoveLeft;

           Ins : InsertChar;

           Del : DeleteChar;

           ESC : Begin
                   Next := True;
                   Done := True;
                   Result := ESC
                 end;  {ESC}

  Else
    Begin
      Next := True;
      Done := True;
      InString := WorkString;
      Result := Ch
    end  {Else}
  End  {Case}
End;  {ContCh}


Begin {GetString -- At Last!}
  Initialize;
  if not done then
    begin
      TextColor(Black);
      TextBackground(LightGray);
      WriteString(WorkString);
      If not (Picture[Pos] in PicChar) then MoveRight;
      While not done do
        begin
          Next := False;
          Case Picture[Pos] of
            '9' : Repeat
                    Ch := GetChar;
                    If Ch in DigitChar then AcceptCh
                    Else if Ch in CntChar then ContCh
                    Else Write(BEL)
                  Until Next;
            'A' : Repeat
                    Ch := GetChar;
                    If Ch in AlphaChar then AcceptCh
                    Else if Ch in CntChar then ContCh
                    Else Write(BEL)
                  Until Next;
            '!' : Begin
                    Ch := UpCase(GetChar);
                    If Ch in CntChar then ContCh
                    Else AcceptCh
                  End;
            ' ' : Begin
                    Ch := GetChar;
                    If Ch in CntChar then ContCh
                    Else AcceptCh
                  End;
            Else
              begin
                Ch := GetChar;
                if Ch in CntChar then ContCh
              end  {Else}
          end  {Case}
        end;  {While}
      TextColor(White);
      TextBackground(Black);
      GotoXY(StartCol,Row);
      Write(SP:Length(Picture));
      WriteString(Instring)
    End  {If Not Done}
End;  {GetString}